home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue53 / XML / XmlClasses.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-12-11  |  50.8 KB  |  1,902 lines
  1. unit XmlClasses;
  2.  
  3. interface
  4.  
  5. uses Classes, SysUtils, MSXML_TLB, Dialogs, ComCtrls, ImgList, Graphics;
  6.  
  7. type
  8.   TXmlNodeType = (xntDocument, xntElement, xntDocumentFragment,
  9.       xntText, xntComment, xntCDATASection);
  10.  
  11.   TCharEntity = (ceLt, ceGt, ceQuot, ceApos, ceAmp);
  12.  
  13.   TCharEntities = set of TCharEntity;
  14.  
  15.   TSubstituteCharEntitiesEvent = procedure(Sender: TObject;
  16.       var Text: String; var SkipTranslation: Boolean) of Object;
  17.  
  18. const
  19.   XmlNodeNames: array[xntDocument..xntCDATASection] of String =
  20.       ('#document', '', '#document-fragment', '#text',
  21.           '#comment', '#cdata-section');
  22.  
  23. type
  24.   EXmlDError = class(Exception);
  25.  
  26.   EXmlDParseError = class(Exception)
  27.     FErrorCode:   Integer;
  28.     FReason:      String;
  29.     FSrcText:     String;
  30.     FLine:        Integer;
  31.     FLinePos:     Integer;
  32.   public
  33.     constructor Create(ParseError: IXMLDOMParseError);
  34.     procedure ShowParseError;
  35.     property ErrorCode: Integer read FErrorCode;
  36.     property Reason: String read FReason;
  37.     property SrcText: String read FSrcText;
  38.     property Line: Integer read FLine;
  39.     property LinePos: Integer read FLinePos;
  40.   end;
  41.  
  42.   TXmlName = String;
  43.  
  44.   TXmlDDocument = class;
  45.   TXmlDStructureNode = class;
  46.   TXmlDElement = class;
  47.   TXmlDDocumentFragment = class;
  48.   TXmlDCDATASection = class;
  49.   TXmlDComment = class;
  50.   TXmlDText = class;
  51.   TXmlDAttrList = class;
  52.   TXmlDElementIterator = class;
  53.   TXmlDElementPattern = class;
  54.  
  55.   TXmlDNode = class(TPersistent)
  56.     private
  57.       FPreviousSibling: TXmlDNode;
  58.       FNextSibling:     TXmlDNode;
  59.       FParentNode:      TXmlDStructureNode;
  60.       FNodeType:        TXmlNodeType;
  61.       FTag:             Integer;
  62.       FLevel:           Integer;
  63.     protected
  64.       function GetFirstChild: TXmlDNode; virtual;
  65.       function GetLastChild: TXmlDNode; virtual;
  66.       function GetOwnerDocument: TXmlDDocument;
  67.       function GetNodeName: TXmlName; virtual;
  68.       function GetNodeValue: String; virtual;
  69.       procedure SetLevel(Lvl: Integer);
  70.       procedure SetNodeName(const Value: TXmlName); virtual;
  71.       procedure SetNodeValue(const Value: String); virtual;
  72.       procedure SetParent(ParentNode: TXmlDStructureNode);
  73.       procedure WriteToStream(Stream: TStream;
  74.           FormattedForPrint: Boolean); virtual; abstract;
  75.       procedure WriteFormattedPrefix(Stream: TStream);
  76.       procedure WriteFormattedSuffix(Stream: TStream);
  77.     public
  78.       constructor Create;
  79.       function CloneNode(RecurseChildren: Boolean = False): TXmlDNode;
  80.           virtual; abstract;
  81.       procedure AppendChild(NewNode: TXmlDNode); virtual;
  82.       function ReplaceChild(NewNode: TXmlDNode; OldNode: TXmlDNode):
  83.           TXmlDNode; virtual;
  84.       procedure InsertBefore(NewNode: TXmlDNode; ThisNode: TXmlDNode);
  85.           virtual;
  86.       function RemoveChild(ThisNode: TXmlDNode): TXmlDNode; virtual;
  87.       function HasChildNodes: Boolean; virtual;
  88.       procedure ZeroAllTags;
  89.       property FirstChild: TXmlDNode read GetFirstChild;
  90.       property LastChild: TXmlDNode read GetLastChild;
  91.       property PreviousSibling: TXmlDNode read FPreviousSibling;
  92.       property NextSibling: TXmlDNode read FNextSibling;
  93.       property ParentNode: TXmlDStructureNode read FParentNode;
  94.       property OwnerDocument: TXmlDDocument read GetOwnerDocument;
  95.       property NodeName: TXmlName read GetNodeName write SetNodeName;
  96.       property NodeType: TXmlNodeType read FNodeType;
  97.       property NodeValue: String read GetNodeValue write SetNodeValue;
  98.       property Level: Integer read FLevel;
  99.       property Tag: Integer read FTag write FTag;
  100.   end;
  101.  
  102.   TXmlDStructureNode = class(TXmlDNode)
  103.     private
  104.       FAttrList:        TXmlDAttrList;
  105.       FFirstChild:      TXmlDNode;
  106.       FLastChild:       TXmlDNode;
  107.       FElementCount:    Integer;
  108.     protected
  109.       procedure AppendDocFragChild(NewNode: TXmlDDocumentFragment);
  110.       procedure AssignAttrNodesToTreeNodes(ParXmlNode: TXmlDNode;
  111.         ParTreeNode: TTreeNode);
  112.       procedure AssignNodeToTreeNode(XmlNode: TXmlDNode;
  113.         TreeNode: TTreeNode);
  114.       procedure CloneChildren(FromNode: TXmlDStructureNode);
  115.       function GetElementByName(const Name: String): TXmlDElement;
  116.       function GetElements(Index: Integer): TXmlDElement;
  117.       procedure InsertDocFragBefore(NewNode: TXmlDDocumentFragment;
  118.           ThisNode: TXmlDNode);
  119.       procedure WriteChildrenToStream(Stream: TStream;
  120.           FormattedForPrint:Boolean);
  121.     public
  122.       constructor Create;
  123.       destructor Destroy; override;
  124.       procedure AssignTo(Dest: TPersistent); override;
  125.       function GetFirstChild: TXmlDNode; override;
  126.       function GetLastChild: TXmlDNode; override;
  127.       procedure AppendChild(NewNode: TXmlDNode); override;
  128.       procedure InsertBefore(NewNode: TXmlDNode; ThisNode: TXmlDNode);
  129.           override;
  130.       function ReplaceChild(NewNode: TXmlDNode; OldNode: TXmlDNode):
  131.           TXmlDNode; override;
  132.       function RemoveChild(ThisNode: TXmlDNode): TXmlDNode; override;
  133.       function HasChildNodes: Boolean; override;
  134.       function GetFirstChildElement: TXmlDElement;
  135.       property AttrList: TXmlDAttrList read FAttrList;
  136.       property ElementCount: Integer read FElementCount;
  137.       property Elements[Index: Integer]: TXmlDElement read GetElements;
  138.       property ElementByName[const Name: String]: TXmlDElement
  139.           read GetElementByName; default;
  140.     end;
  141.  
  142.   TXmlDContentNode = class(TXmlDNode)
  143.     private
  144.       FValue: String;
  145.     protected
  146.       function GetNodeValue: String; override;
  147.       procedure SetNodeValue(const Value: String); override;
  148.   end;
  149.  
  150.   TXmlDDocument = class(TXmlDStructureNode)
  151.     private
  152.       FDocumentElement: TXmlDElement;
  153.       FDocumentTypeDefinition: String;
  154.       FAttrCharEntities: TCharEntities;
  155.       FTextCharEntities: TCharEntities;
  156.       FOnOutputAttrValue: TSubstituteCharEntitiesEvent;
  157.       FOnOutputTextValue: TSubstituteCharEntitiesEvent;
  158.       DiscardUnsupportedItems: Boolean;
  159.     protected
  160.       procedure WriteToStream(Stream: TStream;
  161.           FormattedForPrint: Boolean); override;
  162.       procedure WritePrologToStream(Stream: TStream);
  163.       procedure DecodePrologAttrs(S: String);
  164.       procedure LoadFromDOMDocument(Doc: IXMLDOMDocument);
  165.       procedure LoadChildNodes(ParNode: TXmlDNode;
  166.           ParDOMNode: IXMLDOMNode);
  167.       procedure LoadAttributes(Node: TXmlDElement;
  168.           DOMNode: IXMLDOMNode);
  169.     public
  170.       constructor Create;
  171.       function CloneNode(RecurseChildren: Boolean = False): TXmlDNode;
  172.           override;
  173.       procedure Clear;
  174.       procedure AppendChild(NewNode: TXmlDNode); override;
  175.       function ReplaceChild(NewNode: TXmlDNode; OldNode: TXmlDNode):
  176.           TXmlDNode; override;
  177.       procedure InsertBefore(NewNode: TXmlDNode; ThisNode: TXmlDNode);
  178.           override;
  179.       function RemoveChild(ThisNode: TXmlDNode): TXmlDNode; override;
  180.       function CreateCDATASection(const Text: String):
  181.           TXmlDCDATASection;
  182.       function CreateComment(const Text: String): TXmlDComment;
  183.       function CreateDocumentFragment: TXmlDDocumentFragment;
  184.       function CreateElement(const TagName: TXmlName): TXmlDElement;
  185.           overload;
  186.       function CreateElement(const TagName: TXmlName;
  187.           const Data: String): TXmlDElement; overload;
  188.       function CreateElement(const TagName: TXmlName;
  189.           const Data: String; const AttrName: TXmlName;
  190.           const AttrValue: String): TXmlDElement; overload;
  191.       function CreateElement(const TagName: TXmlName;
  192.           const Data: String; const AttrNames: array of TXmlName;
  193.           const AttrValues: array of String): TXmlDElement; overload;
  194.       function CreateTextNode(const Text: String): TXmlDText;
  195.       procedure LoadFromStream(Stream: TStream;
  196.           ValidateOnParse: Boolean = True;
  197.           DiscardUnsupportedItems: Boolean = False);
  198.       procedure LoadFromFile(const FileName: String;
  199.           ValidateOnParse: Boolean = True;
  200.           DiscardUnsupportedItems: Boolean = False);
  201.       procedure SaveToStream(Stream: TStream;
  202.           FormattedForPrint: Boolean = False);
  203.       procedure SaveToFile(const FileName: String;
  204.           FormattedForPrint: Boolean = False);
  205.       property DocumentElement: TXmlDElement read FDocumentElement;
  206.       property DocumentTypeDefinition: String
  207.           read FDocumentTypeDefinition write FDocumentTypeDefinition;
  208.       property AttrCharEntities: TCharEntities read FAttrCharEntities
  209.           write FAttrCharEntities;
  210.       property TextCharEntities: TCharEntities read FTextCharEntities
  211.           write FTextCharEntities;
  212.       property OnOutputAttrValue: TSubstituteCharEntitiesEvent
  213.           read FOnOutputAttrValue write FOnOutputAttrValue;
  214.       property OnOutputTextValue: TSubstituteCharEntitiesEvent
  215.           read FOnOutputTextValue write FOnOutputTextValue;
  216.   end;
  217.  
  218.   TXmlDElement = class(TXmlDStructureNode)
  219.     private
  220.       FNodeName:        TXmlName;
  221.     protected
  222.       function GetNodeName: TXmlName; override;
  223.       function GetAsBoolean: Boolean;
  224.       function GetAsCurrency: Currency;
  225.       function GetAsDate: TDateTime;
  226.       function GetAsDateTime: TDateTime;
  227.       function GetAsInteger: Integer;
  228.       function GetAsString: String;
  229.       function GetAsTime: TDateTime;
  230.       function GetFirstTextNodeValue: String;
  231.       procedure SetAsBoolean(const Value: Boolean);
  232.       procedure SetAsCurrency(const Value: Currency);
  233.       procedure SetAsDate(const Value: TDateTime);
  234.       procedure SetAsDateTime(const Value: TDateTime);
  235.       procedure SetAsInteger(const Value: Integer);
  236.       procedure SetAsString(const Value: String);
  237.       procedure SetAsTime(const Value: TDateTime);
  238.       procedure SetNodeName(const Value: TXmlName); override;
  239.       procedure SetFirstTextNodeValue(const Value: String);
  240.       procedure WriteToStream(Stream: TStream;
  241.           FormattedForPrint: Boolean); override;
  242.     public
  243.       constructor Create;
  244.       function CloneNode(RecurseChildren: Boolean = False): TXmlDNode;
  245.           override;
  246.       function GetNextSiblingElement: TXmlDElement;
  247.       property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean;
  248.       property AsCurrency: Currency read GetAsCurrency
  249.           write SetAsCurrency;
  250.       property AsDate: TDateTime read GetAsDate write SetAsDate;
  251.       property AsDateTime: TDateTime read GetAsDateTime
  252.           write SetAsDateTime;
  253.       property AsInteger: Integer read GetAsInteger write SetAsInteger;
  254.       property AsTime: TDateTime read GetAsTime write SetAsTime;
  255.       property AsString: String read GetAsString write SetAsString;
  256.   end;
  257.  
  258.   TXmlDDocumentFragment = class(TXmlDStructureNode)
  259.     protected
  260.       procedure WriteToStream(Stream: TStream;
  261.           FormattedForPrint: Boolean); override;
  262.     public
  263.       constructor Create;
  264.       function CloneNode(RecurseChildren: Boolean = False): TXmlDNode;
  265.           override;
  266.   end;
  267.  
  268.   TXmlDText = class(TXmlDContentNode)
  269.   protected
  270.     procedure WriteToStream(Stream: TStream;
  271.         FormattedForPrint: Boolean); override;
  272.   public
  273.     constructor Create;
  274.     function CloneNode(RecurseChildren: Boolean): TXmlDNode; override;
  275.   end;
  276.  
  277.   TXmlDComment = class(TXmlDContentNode)
  278.   protected
  279.     procedure WriteToStream(Stream: TStream;
  280.         FormattedForPrint: Boolean); override;
  281.   public
  282.     constructor Create;
  283.     function CloneNode(RecurseChildren: Boolean): TXmlDNode; override;
  284.   end;
  285.  
  286.   TXmlDCDATASection = class(TXmlDContentNode)
  287.   protected
  288.     procedure WriteToStream(Stream: TStream;
  289.         FormattedForPrint: Boolean); override;
  290.   public
  291.     constructor Create;
  292.     function CloneNode(RecurseChildren: Boolean): TXmlDNode; override;
  293.   end;
  294.  
  295.   TXmlDAttrList = class(TPersistent)
  296.   private
  297.     List:       TStringList;
  298.     FOwnerNode: TXmlDStructureNode;
  299.   protected
  300.     function Add(const S: String): Integer;
  301.     function GetCount: Integer;
  302.     function GetValues(const Name: TXmlName): String;
  303.     function GetNames(Index: Integer): TXmlName;
  304.     procedure SetValues(const Name: TXmlName; const Value: String);
  305.     procedure WriteToStream(Stream: TStream);
  306.   public
  307.     constructor Create;
  308.     destructor Destroy; override;
  309.     procedure Assign(Source: TPersistent); override;
  310.     procedure Clear;
  311.     property Count: Integer read GetCount;
  312.     property OwnerNode: TXmlDStructureNode read FOwnerNode;
  313.     property Names[Index: Integer]: TXmlName read GetNames;
  314.     property Values[const Name: TXmlName]: String read GetValues
  315.         write SetValues; default;
  316.   end;
  317.  
  318.   TXmlDElementIterator = class(TObject)
  319.   private
  320.     CurrNode: TXmlDStructureNode;
  321.     RootNode: TXmlDStructurenode;
  322.     Position: TList;
  323.     ElementPattern: TXmlDElementPattern;
  324.   protected
  325.     function NextElementInPattern: TXmlDElement;
  326.     function NextElementInStructure: TXmlDElement;
  327.   public
  328.     constructor Create(ContextNode: TXmlDStructureNode = nil;
  329.         const Pattern: String = '');
  330.     destructor Destroy; override;
  331.     function Next: TXmlDElement;
  332.     procedure Reset(ContextNode: TXmlDStructureNode = nil;
  333.         const Pattern: String = '');
  334.   end;
  335.  
  336.   TElementPatternMatch = (epmNoMatch, epmPathMatch, epmEndMatch);
  337.  
  338.   TXmlDElementPattern = class(TObject)
  339.   private
  340.     RootNode: TXmlDStructureNode;
  341.     PatternPieces: TStringList;
  342.     PatternLevels: Integer;
  343.   protected
  344.     procedure ParsePattern(const Pattern: String);
  345.   public
  346.     constructor Create(ContextNode: TXmlDStructureNode;
  347.         const Pattern: String);
  348.     destructor Destroy; override;
  349.     function PatternMatchType(ELement: TXmlDElement):
  350.         TElementPatternMatch;
  351.   end;
  352.  
  353. implementation
  354.  
  355. {$R XMLTreeView.res}
  356.  
  357. { Utility Functions }
  358.  
  359. function CharEntitiesReplace(const S: String; CE: TCharEntities):
  360.     String;
  361. begin
  362.   Result := S;
  363.   if ceAmp in CE then
  364.     Result := StringReplace(Result, '&', '&', [rfReplaceAll]);
  365.   if ceLt in CE then
  366.     Result := StringReplace(Result, '<', '<', [rfReplaceAll]);
  367.   if ceGt in CE then
  368.     Result := StringReplace(Result, '>', '>', [rfReplaceAll]);
  369.   if ceApos in CE then
  370.     Result := StringReplace(Result, '''', ''', [rfReplaceAll]);
  371.   if ceQuot in CE then
  372.     Result := StringReplace(Result, '"', '"', [rfReplaceAll]);
  373. end;
  374.  
  375. function ISOStrToDate(const Date: String): TDateTime;
  376. var
  377.   WorkStr: String;
  378.   Y: Word;
  379.   M: Word;
  380.   D: Word;
  381. begin
  382.   WorkStr := StringReplace(Date, '-', '', [rfReplaceAll]);
  383.   if Length(WorkStr) = 6 then
  384.     WorkStr := Copy(FormatDateTime('yyyy', SysUtils.Date), 1, 2) +
  385.         WorkStr;
  386.   Y := StrToInt(Copy(WorkStr, 1, 4));
  387.   M := StrToInt(Copy(WorkStr, 5, 2));
  388.   D := StrToInt(Copy(WorkStr, 7, 2));
  389.   Result := EncodeDate(Y, M, D);
  390. end;
  391.  
  392. function ISOStrToTime(const Time: String): TDateTime;
  393. var
  394.   H: Word;
  395.   M: Word;
  396.   S: Word;
  397. begin
  398.   H := StrToInt(Copy(Time, 1, 2));
  399.   M := StrToInt(Copy(Time, 4, 2));
  400.   S := 0;
  401.   if Length(Time) > 5 then
  402.     S := StrToInt(Copy(Time, 7, 2));
  403.   Result := EncodeTime(H, M, S, 0);
  404. end;
  405.  
  406. function ISOStrToDateTime(const Value: String): TDateTime;
  407. var
  408.   I: Integer;
  409.   Date: String;
  410.   Time: String;
  411. begin
  412.   I := Pos('T', Value);
  413.   if I > 0 then
  414.   begin
  415.     Date := Copy(Value, 1, (I - 1));
  416.     Time := Copy(Value, (I + 1), $7FFF);
  417.   end
  418.   else
  419.     Date := Value;
  420.   try
  421.     Result := ISOStrToDate(Date) + ISOStrToTime(Time);
  422.   except
  423.     raise EXmlDError.Create('Invalid ISO date/time string ' +
  424.         'encountered: ' + Value);
  425.   end;
  426. end;
  427.  
  428. function ISODateToStr(Value: TDateTime): String;
  429. begin
  430.   Result := FormatDateTime('yyyy-mm-dd', Value);
  431. end;
  432.  
  433. function ISODateTimeToStr(Value: TDateTime): String;
  434. begin
  435.   Result := FormatDateTime('yyyy-mm-dd"T"hh:nn:ss', Value);
  436. end;
  437.  
  438. function ISOTimeToStr(Value: TDateTime): String;
  439. begin
  440.   Result := FormatDateTime('hh:nn:ss', Value);
  441. end;
  442.  
  443. { EXmlDParseError }
  444.  
  445. constructor EXmlDParseError.Create(ParseError: IXMLDOMParseError);
  446. begin
  447.   inherited Create('XML Parse Error');
  448.   FErrorCode := ParseError.errorCode;
  449.   FReason := ParseError.reason;
  450.   FSrcText := ParseError.srcText;
  451.   FLine := ParseError.line;
  452.   FLinePos := ParseError.linePos;
  453. end;
  454.  
  455. procedure EXmlDParseError.ShowParseError;
  456. var
  457.   S:  String;
  458. begin
  459.   S := 'XML Parse Error:' + FReason +
  460.       'Line=' + IntToStr(FLine) +
  461.       ' LinePos=' + IntToStr(FLinePos);
  462.   MessageDlg(S, mtError, [mbOK], 0);
  463. end;
  464.  
  465. { TXmlDNode }
  466.  
  467. procedure TXmlDNode.AppendChild(NewNode: TXmlDNode);
  468. begin
  469.   raise EXmlDError.Create('AppendChild operation requested on ' +
  470.       'invalid node type');
  471. end;
  472.  
  473. constructor TXmlDNode.Create;
  474. begin
  475.   inherited Create;
  476. end;
  477.  
  478. function TXmlDNode.GetFirstChild: TXmlDNode;
  479. begin
  480.   Result := nil;
  481. end;
  482.  
  483. function TXmlDNode.GetLastChild: TXmlDNode;
  484. begin
  485.   Result := nil;
  486. end;
  487.  
  488. function TXmlDNode.GetNodeName: TXmlName;
  489. begin
  490.   Result := XmlNodeNames[FNodeType];
  491. end;
  492.  
  493. function TXmlDNode.GetNodeValue: String;
  494. begin
  495.   Result := '';
  496. end;
  497.  
  498. function TXmlDNode.GetOwnerDocument: TXmlDDocument;
  499. var
  500.   ANode: TXmlDStructureNode;
  501. begin
  502.   ANode := TXmlDStructureNode(Self);
  503.   while ANode.FParentNode <> nil do
  504.     ANode := ANode.FParentNode;
  505.   Result := ANode as TXmlDDocument;
  506. end;
  507.  
  508. function TXmlDNode.HasChildNodes: Boolean;
  509. begin
  510.   Result := False;
  511. end;
  512.  
  513. procedure TXmlDNode.InsertBefore(NewNode, ThisNode: TXmlDNode);
  514. begin
  515.   raise EXmlDError.Create('InsertBefore operation requested on ' +
  516.       'invalid node type');
  517. end;
  518.  
  519. function TXmlDNode.RemoveChild(ThisNode: TXmlDNode): TXmlDNode;
  520. begin
  521.   raise EXmlDError.Create('RemoveChild operation requested on ' +
  522.       'invalid node type');
  523. end;
  524.  
  525. function TXmlDNode.ReplaceChild(NewNode, OldNode: TXmlDNode):
  526.     TXmlDNode;
  527. begin
  528.   raise EXmlDError.Create('ReplaceChild operation requested on ' +
  529.       'invalid node type');
  530. end;
  531.  
  532. procedure TXmlDNode.SetLevel(Lvl: Integer);
  533.   procedure SetLvl(Node: TXmlDNode; Lvl: Integer);
  534.   var
  535.     ChildNode: TXmlDNode;
  536.   begin
  537.     Node.FLevel := Lvl;
  538.     ChildNode := Node.FirstChild;
  539.     while ChildNode <> nil do
  540.     begin
  541.       SetLvl(ChildNode, (Lvl + 1));
  542.       ChildNode := ChildNode.NextSibling;
  543.     end;
  544.   end;
  545. begin
  546.   SetLvl(Self, Lvl);
  547. end;
  548.  
  549. procedure TXmlDNode.SetNodeName(const Value: TXmlName);
  550. begin
  551. end;
  552.  
  553. procedure TXmlDNode.SetNodeValue(const Value: String);
  554. begin
  555. end;
  556.  
  557. procedure TXmlDNode.SetParent(ParentNode: TXmlDStructureNode);
  558. begin
  559.   if (FParentNode <> nil) and (NodeType = xntElement) then
  560.     Dec(FParentNode.FElementCount);
  561.   FParentNode := ParentNode;
  562.   if FParentNode <> nil then
  563.     SetLevel(FParentNode.FLevel + 1)
  564.   else
  565.     SetLevel(0);
  566.   if (FParentNode <> nil) and (NodeType = xntElement) then
  567.     Inc(FParentNode.FElementCount);
  568. end;
  569.  
  570. procedure TXmlDNode.WriteFormattedPrefix(Stream: TStream);
  571. var
  572.   S:  String;
  573. begin
  574.   S := StringOfChar(' ', (Level - 1) * 2);
  575.   Stream.WriteBuffer(Pointer(S)^, Length(S));
  576. end;
  577.  
  578. procedure TXmlDNode.WriteFormattedSuffix(Stream: TStream);
  579. const
  580.   CRLF:  String[3] = #13#10;
  581. begin
  582.   Stream.WriteBuffer(CRLF[1], 2);
  583. end;
  584.  
  585. procedure TXmlDNode.ZeroAllTags;
  586.   procedure ZeroTag(Node: TXmlDNode);
  587.   var
  588.     ChildNode: TXmlDNode;
  589.   begin
  590.     Node.Tag := 0;
  591.     ChildNode := Node.FirstChild;
  592.     while ChildNode <> nil do
  593.     begin
  594.       ZeroTag(ChildNode);
  595.       ChildNode := ChildNode.NextSibling;
  596.     end;
  597.   end;
  598. begin
  599.   ZeroTag(Self);
  600. end;
  601.  
  602. { TXmlDStructureNode }
  603.  
  604. procedure TXmlDStructureNode.AppendChild(NewNode: TXmlDNode);
  605. begin
  606.   if NewNode.NodeType = xntDocumentFragment then
  607.     AppendDocFragChild(TXmlDDocumentFragment(NewNode))
  608.   else
  609.   begin
  610.     NewNode.SetParent(Self);
  611.     if FFirstChild = nil then
  612.     begin
  613.       FFirstChild := NewNode;
  614.       FLastChild := NewNode;
  615.     end
  616.     else
  617.     begin
  618.       FLastChild.FNextSibling := NewNode;
  619.       NewNode.FPreviousSibling := FLastChild;
  620.       FLastChild := NewNode;
  621.     end;
  622.   end;
  623. end;
  624.  
  625. procedure TXmlDStructureNode.AppendDocFragChild(
  626.   NewNode: TXmlDDocumentFragment);
  627. var
  628.   CurrNode: TXmlDNode;
  629.   NextNode: TXmlDNode;
  630. begin
  631.   CurrNode := NewNode.FirstChild;
  632.   while CurrNode <> nil do
  633.   begin
  634.     NextNode := CurrNode.NextSibling;
  635.     AppendChild(NewNode.RemoveChild(CurrNode));
  636.     CurrNode := NextNode;
  637.   end;
  638. end;
  639.  
  640. procedure TXmlDStructureNode.AssignAttrNodesToTreeNodes(
  641.     ParXmlNode: TXmlDNode; ParTreeNode: TTreeNode);
  642. var
  643.   I:  Integer;
  644.   S:  String;
  645.   TreeNode: TTreeNode;
  646.   XSN: TXmlDStructureNode;
  647. begin
  648.   XSN := ParXmlNode as TXmlDStructureNode;
  649.   for I := 0 to (XSN.FAttrList.Count - 1) do
  650.   begin
  651.     S := StringReplace(XSN.FAttrList.List.Strings[I],
  652.         '=', '="', []) + '"';
  653.     TreeNode := ParTreeNode.Owner.AddChild(ParTreeNode, S);
  654.     if ParXmlNode.NodeType = xntDocument then
  655.       TreeNode.ImageIndex := 1
  656.     else
  657.       TreeNode.ImageIndex := 3;
  658.     TreeNode.SelectedIndex := TreeNode.ImageIndex;
  659.     TreeNode.Data := XSN.FAttrList;
  660.   end;
  661. end;
  662.  
  663. procedure TXmlDStructureNode.AssignNodeToTreeNode(XmlNode: TXmlDNode;
  664.     TreeNode: TTreeNode);
  665. begin
  666.   case XmlNode.NodeType of
  667.     xntDocument:
  668.     begin
  669.       TreeNode.Text := 'XML Document';
  670.       TreeNode.ImageIndex := 0;
  671.       AssignAttrNodesToTreeNodes(XmlNode, TreeNode);
  672.     end;
  673.     xntElement:
  674.     begin
  675.       TreeNode.Text := XmlNode.NodeName;
  676.       TreeNode.ImageIndex := 2;
  677.       AssignAttrNodesToTreeNodes(XmlNode, TreeNode);
  678.     end;
  679.     xntText:
  680.     begin
  681.       TreeNode.Text := XmlNode.NodeValue;
  682.       TreeNode.ImageIndex := 4;
  683.     end;
  684.     xntCDATASection:
  685.     begin
  686.       TreeNode.Text := XmlNode.NodeValue;
  687.       TreeNode.ImageIndex := 5;
  688.     end;
  689.     xntComment:
  690.     begin
  691.       TreeNode.Text := XmlNode.NodeValue;
  692.       TreeNode.ImageIndex := 6;
  693.     end;
  694.     xntDocumentFragment:
  695.     begin
  696.       TreeNode.Text := 'XML Document Fragment';
  697.       TreeNode.ImageIndex := 0;
  698.     end;
  699.   end;
  700.   TreeNode.SelectedIndex := TreeNode.ImageIndex;
  701.   TreeNode.Data := XmlNode;
  702. end;
  703.  
  704. procedure TXmlDStructureNode.AssignTo(Dest: TPersistent);
  705. var
  706.   TV: TTreeView;
  707.   TN: TTreeNodes;
  708.   TreeNode: TTreeNode;
  709.  
  710.   procedure AddChildNodes(ParXmlNode: TXmlDNode;
  711.       ParTreeNode: TTreeNode);
  712.   var
  713.     XmlNode:  TXmlDNode;
  714.     TreeNode: TTreeNode;
  715.   begin
  716.     XmlNode := ParXmlNode.FirstChild;
  717.     while (XmlNode <> nil) do
  718.     begin
  719.       TreeNode := TN.AddChild(ParTreeNode, '');
  720.       AssignNodeToTreeNode(XmlNode, TreeNode);
  721.       AddChildNodes(XmlNode, TreeNode);
  722.       XmlNode := XmlNode.NextSibling;
  723.     end;
  724.   end;
  725.  
  726. begin
  727.   if Dest is TTreeNodes then
  728.   begin
  729.     TN := TTreeNodes(Dest);
  730.     TV := TTreeView(TN.Owner);
  731.     TV.SortType := stNone;
  732.     TV.ReadOnly := True;
  733.     if TV.Images = nil then
  734.       TV.Images := TCustomImageList.Create(TV);
  735.     TV.Images.Clear;
  736.     TV.Images.GetResource(rtBitmap,
  737.         'XMLTREEVIEWNODES', 0, [], 0);
  738.     TV.Images.BkColor := clBlack;
  739.     TN.BeginUpdate;
  740.     TreeNode := TN.AddChild(nil, '');
  741.     AssignNodeToTreeNode(Self, TreeNode);
  742.     AddChildNodes(Self, TreeNode);
  743.     TN.EndUpdate;
  744.   end
  745.   else
  746.     inherited AssignTo(Dest);
  747. end;
  748.  
  749. procedure TXmlDStructureNode.CloneChildren(FromNode: TXmlDStructureNode);
  750. var
  751.   N:  TXmlDNode;
  752. begin
  753.   N := FromNode.FFirstChild;
  754.   while N <> nil do
  755.   begin
  756.     AppendChild(N.CloneNode(True));
  757.     N := N.NextSibling;
  758.   end;
  759. end;
  760.  
  761. constructor TXmlDStructureNode.Create;
  762. begin
  763.   FAttrList := TXmlDAttrList.Create;
  764.   FAttrList.FOwnerNode := Self;
  765. end;
  766.  
  767. destructor TXmlDStructureNode.Destroy;
  768. var
  769.   Node: TXmlDNode;
  770.   NextNode: TXmlDNode;
  771. begin
  772.   Node := FFirstChild;
  773.   while (Node <> nil) do
  774.   begin
  775.     NextNode := Node.FNextSibling;
  776.     Node.Free;
  777.     Node := NextNode;
  778.   end;
  779.   FAttrList.Free;
  780.   inherited Destroy;
  781. end;
  782.  
  783. function TXmlDStructureNode.GetElementByName(
  784.   const Name: String): TXmlDElement;
  785. var
  786.   ChildNode: TXmlDElement;
  787. begin
  788.   Result := nil;
  789.   ChildNode := GetFirstChildElement;
  790.   while ((ChildNode <> nil) and (Result = nil)) do
  791.   begin
  792.     if ChildNode.NodeName = Name then
  793.       Result := ChildNode;
  794.     ChildNode := ChildNode.GetNextSiblingElement;
  795.   end;
  796.   if Result = nil then
  797.     raise EXmlDError.Create('Invalid GetElementByName call ' +
  798.         'for element named ' + Name);
  799. end;
  800.  
  801. function TXmlDStructureNode.GetElements(Index: Integer): TXmlDElement;
  802. var
  803.   I: Integer;
  804.   ChildNode: TXmlDElement;
  805. begin
  806.   if (Index < 0) or (Index >= ElementCount) then
  807.     raise EXmlDError.Create('Invalid GetElements call ' +
  808.         'using index value of ' + IntToStr(Index));
  809.   Result := nil;
  810.   I := -1;
  811.   ChildNode := GetFirstChildElement;
  812.   while ((ChildNode <> nil) and (Result = nil)) do
  813.   begin
  814.     Inc(I);
  815.     if I = Index then
  816.       Result := ChildNode;
  817.     ChildNode := ChildNode.GetNextSiblingElement;
  818.   end;
  819. end;
  820.  
  821. function TXmlDStructureNode.GetFirstChild: TXmlDNode;
  822. begin
  823.   Result := FFirstChild;
  824. end;
  825.  
  826. function TXmlDStructureNode.GetFirstChildElement: TXmlDElement;
  827. var
  828.   ChildNode: TXmlDNode;
  829. begin
  830.   Result := nil;
  831.   ChildNode := FirstChild;
  832.   while ((ChildNode <> nil) and (Result = nil)) do
  833.   begin
  834.     if ChildNode.NodeType = xntElement then
  835.       Result := TXmlDELement(ChildNode);
  836.     ChildNode := ChildNode.NextSibling;
  837.   end;
  838. end;
  839.  
  840. function TXmlDStructureNode.GetLastChild: TXmlDNode;
  841. begin
  842.   Result := FLastChild;
  843. end;
  844.  
  845. function TXmlDStructureNode.HasChildNodes: Boolean;
  846. begin
  847.   Result := FFirstChild <> nil;
  848. end;
  849.  
  850. procedure TXmlDStructureNode.InsertBefore(NewNode, ThisNode: TXmlDNode);
  851. var
  852.   Node: TXmlDNode;
  853. begin
  854.   if ThisNode = nil then
  855.     AppendChild(NewNode)
  856.   else
  857.   begin
  858.     Node := FFirstChild;
  859.     while ((Node <> nil) and (Node <> ThisNode)) do
  860.       Node := Node.FNextSibling;
  861.     if Node = nil then
  862.       AppendChild(NewNode)
  863.     else
  864.     begin
  865.       if NewNode.NodeType = xntDocumentFragment then
  866.         InsertDocFragBefore(TXmlDDocumentFragment(NewNode), ThisNode)
  867.       else
  868.       begin
  869.         if ThisNode = FFirstChild then
  870.           FFirstChild := NewNode;
  871.         if ThisNode.FPreviousSibling <> nil then
  872.           ThisNode.FPreviousSibling.FNextSibling := NewNode;
  873.         NewNode.FPreviousSibling := ThisNode.FPreviousSibling;
  874.         ThisNode.FPreviousSibling := NewNode;
  875.         NewNode.FNextSibling := ThisNode;
  876.         NewNode.SetParent(Self);
  877.       end;
  878.     end;
  879.   end;
  880. end;
  881.  
  882. procedure TXmlDStructureNode.InsertDocFragBefore(
  883.     NewNode: TXmlDDocumentFragment; ThisNode: TXmlDNode);
  884. var
  885.   CurrNode: TXmlDNode;
  886. begin
  887.   CurrNode := NewNode.FirstChild;
  888.   while CurrNode <> nil do
  889.   begin
  890.     InsertBefore(NewNode.RemoveChild(CurrNode), ThisNode);
  891.     CurrNode := NewNode.FirstChild;
  892.   end;
  893. end;
  894.  
  895. function TXmlDStructureNode.RemoveChild(ThisNode: TXmlDNode): TXmlDNode;
  896. begin
  897.   Result := FFirstChild;
  898.   while ((Result <> nil) and (Result <> ThisNode)) do
  899.     Result := Result.FNextSibling;
  900.   if Result <> nil then
  901.   begin
  902.     if FFirstChild = FLastChild then
  903.     begin
  904.       FFirstChild := nil;
  905.       FLastChild := nil;
  906.     end
  907.     else if Result = FFirstChild then
  908.     begin
  909.       FFirstChild := FFirstChild.FNextSibling;
  910.       FFirstChild.FPreviousSibling := nil;
  911.     end
  912.     else if Result = FLastChild then
  913.     begin
  914.       FLastChild := FLastChild.FPreviousSibling;
  915.       FLastChild.FNextSibling := nil;
  916.     end
  917.     else
  918.     begin
  919.       Result.FPreviousSibling.FNextSibling := Result.FNextSibling;
  920.       Result.FNextSibling.FPreviousSibling := Result.FPreviousSibling;
  921.     end;
  922.     Result.FNextSibling := nil;
  923.     Result.FPreviousSibling := nil;
  924.     Result.SetParent(nil);
  925.   end;
  926. end;
  927.  
  928. function TXmlDStructureNode.ReplaceChild(NewNode,
  929.   OldNode: TXmlDNode): TXmlDNode;
  930. var
  931.   NextNode: TXmlDNode;
  932. begin
  933.   if OldNode = FLastChild then
  934.   begin
  935.     Result := RemoveChild(OldNode);
  936.     AppendChild(NewNode);
  937.   end
  938.   else
  939.   begin
  940.     NextNode := OldNode.FNextSibling;
  941.     Result := RemoveChild(OldNode);
  942.     InsertBefore(NewNode, NextNode);
  943.   end;
  944. end;
  945.  
  946. procedure TXmlDStructureNode.WriteChildrenToStream(Stream: TStream;
  947.     FormattedForPrint: Boolean);
  948. var
  949.   N:  TXmlDNode;
  950. begin
  951.   N := FFirstChild;
  952.   while (N <> nil) do
  953.   begin
  954.     N.WriteToStream(Stream, FormattedForPrint);
  955.     N := N.FNextSibling;
  956.   end;
  957. end;
  958.  
  959. { TXmlDContentNode }
  960.  
  961. function TXmlDContentNode.GetNodeValue: String;
  962. begin
  963.   Result := FValue;
  964. end;
  965.  
  966. procedure TXmlDContentNode.SetNodeValue(const Value: String);
  967. begin
  968.   FValue := Value;
  969. end;
  970.  
  971. { TXmlDDocument }
  972.  
  973. procedure TXmlDDocument.AppendChild(NewNode: TXmlDNode);
  974. begin
  975.   if NewNode.NodeType = xntElement then
  976.   begin
  977.     if FDocumentElement <> nil then
  978.       raise EXmlDError.Create('Second document element add attempted');
  979.     FDocumentElement := TXmlDElement(NewNode);
  980.   end;
  981.   inherited AppendChild(NewNode);
  982. end;
  983.  
  984. procedure TXmlDDocument.Clear;
  985. var
  986.   Node: TXmlDNode;
  987.   NextNode: TXmlDNode;
  988. begin
  989.   Node := FFirstChild;
  990.   while (Node <> nil) do
  991.   begin
  992.     NextNode := Node.FNextSibling;
  993.     Node.Free;
  994.     Node := NextNode;
  995.   end;
  996.   FFirstChild := nil;
  997.   FLastChild := nil;
  998.   FDocumentElement := nil;
  999. end;
  1000.  
  1001. function TXmlDDocument.CloneNode(RecurseChildren: Boolean): TXmlDNode;
  1002. var
  1003.   Clone: TXmlDDocument;
  1004. begin
  1005.   Clone := TXmlDDocument.Create;
  1006.   if RecurseChildren then
  1007.     Clone.CloneChildren(Self);
  1008.   Result := Clone;
  1009. end;
  1010.  
  1011. constructor TXmlDDocument.Create;
  1012. begin
  1013.   inherited Create;
  1014.   FNodeType := xntDocument;
  1015.   FAttrCharEntities := [ceQuot, ceAmp];
  1016.   FTextCharEntities := [ceLt, ceAmp];
  1017. end;
  1018.  
  1019. function TXmlDDocument.CreateCDATASection(
  1020.   const Text: String): TXmlDCDATASection;
  1021. begin
  1022.   Result := TXmlDCDATASection.Create;
  1023.   Result.NodeValue := Text;
  1024. end;
  1025.  
  1026. function TXmlDDocument.CreateComment(const Text: String): TXmlDComment;
  1027. begin
  1028.   Result := TXmlDComment.Create;
  1029.   Result.NodeValue := Text;
  1030. end;
  1031.  
  1032. function TXmlDDocument.CreateElement(
  1033.   const TagName: TXmlName): TXmlDElement;
  1034. begin
  1035.   Result := TXmlDElement.Create;
  1036.   Result.NodeName := TagName;
  1037. end;
  1038.  
  1039. function TXmlDDocument.CreateElement(
  1040.   const TagName: TXmlName; const Data: String): TXmlDElement;
  1041. begin
  1042.   Result := TXmlDElement.Create;
  1043.   Result.NodeName := TagName;
  1044.   if Data <> '' then
  1045.     Result.AppendChild(OwnerDocument.CreateTextNode(Data));
  1046. end;
  1047.  
  1048. function TXmlDDocument.CreateElement(const TagName: TXmlName;
  1049.   const Data: String; const AttrName: TXmlName;
  1050.   const AttrValue: String): TXmlDElement;
  1051. begin
  1052.   Result := TXmlDElement.Create;
  1053.   Result.NodeName := TagName;
  1054.   if AttrName <> '' then
  1055.     Result.FAttrList.Values[AttrName] := AttrValue;
  1056.   if Data <> '' then
  1057.     Result.AppendChild(OwnerDocument.CreateTextNode(Data));
  1058. end;
  1059.  
  1060. function TXmlDDocument.CreateDocumentFragment: TXmlDDocumentFragment;
  1061. begin
  1062.   Result := TXmlDDocumentFragment.Create;
  1063. end;
  1064.  
  1065. function TXmlDDocument.CreateElement(const TagName: TXmlName;
  1066.   const Data: String; const AttrNames: array of TXmlName;
  1067.   const AttrValues: array of String): TXmlDElement;
  1068. var
  1069.   I:  Integer;
  1070. begin
  1071.   if (Low(AttrNames) <> Low(AttrValues)) or
  1072.       (High(AttrNames) <> High(AttrValues)) then
  1073.     raise EXmlDError.Create('Invalid CreateElement call');
  1074.   Result := TXmlDElement.Create;
  1075.   Result.NodeName := TagName;
  1076.   for I := Low(AttrNames) to High(AttrNames) do
  1077.     if AttrNames[I] <> '' then
  1078.       Result.FAttrList.Values[AttrNames[I]] := AttrValues[I];
  1079.   if Data <> '' then
  1080.     Result.AppendChild(OwnerDocument.CreateTextNode(Data));
  1081. end;
  1082.  
  1083. function TXmlDDocument.CreateTextNode(const Text: String): TXmlDText;
  1084. begin
  1085.   Result := TXmlDText.Create;
  1086.   Result.NodeValue := Text;
  1087. end;
  1088.  
  1089. procedure TXmlDDocument.DecodePrologAttrs(S: String);
  1090. var
  1091.   I: Integer;
  1092. begin
  1093.   I := Pos(' ', S);
  1094.   while I > 0 do
  1095.   begin
  1096.     FAttrList.Add(StringReplace(
  1097.         Copy(S, 1, I - 1), '"', '', [rfReplaceAll]));
  1098.     S := TrimLeft(Copy(S, I + 1, $7FFF));
  1099.     I := Pos(' ', S);
  1100.   end;
  1101.   FAttrList.Add(StringReplace(S, '"', '', [rfReplaceAll]));
  1102. end;
  1103.  
  1104. procedure TXmlDDocument.InsertBefore(NewNode, ThisNode: TXmlDNode);
  1105. begin
  1106.   if NewNode.NodeType = xntElement then
  1107.   begin
  1108.     if FDocumentElement <> nil then
  1109.       raise EXmlDError.Create('Second document element add attempted');
  1110.     FDocumentElement := TXmlDElement(NewNode);
  1111.   end;
  1112.   inherited InsertBefore(NewNode, ThisNode);
  1113. end;
  1114.  
  1115. procedure TXmlDDocument.LoadAttributes(Node: TXmlDElement;
  1116.   DOMNode: IXMLDOMNode);
  1117. var
  1118.   I:  Integer;
  1119.   Attributes: IXMLDOMNamedNodeMap;
  1120.   Item: IXMLDOMNode;
  1121. begin
  1122.   Attributes := DOMNode.attributes;
  1123.   for I := 0 to (Attributes.length - 1) do
  1124.   begin
  1125.     Item := Attributes[I];
  1126.     Node.FAttrList[Item.nodeName] := Item.nodeValue;
  1127.   end;
  1128. end;
  1129.  
  1130. procedure TXmlDDocument.LoadChildNodes(ParNode: TXmlDNode;
  1131.   ParDOMNode: IXMLDOMNode);
  1132. var
  1133.   ChildDOMNode: IXMLDOMNode;
  1134.   NewNode:  TXmlDNode;
  1135. begin
  1136.   ChildDOMNode := ParDOMNode.firstChild;
  1137.   while ChildDOMNode <> nil do
  1138.   begin
  1139.     NewNode := nil;
  1140.     case ChildDOMNode.nodeType of
  1141.       NODE_ELEMENT:
  1142.       begin
  1143.         NewNode := CreateElement(ChildDOMNode.nodeName);
  1144.         LoadAttributes(TXmlDElement(NewNode), ChildDOMNode);
  1145.       end;
  1146.       NODE_TEXT:
  1147.         NewNode := CreateTextNode(ChildDOMNode.nodeValue);
  1148.       NODE_CDATA_SECTION:
  1149.         NewNode := CreateCDataSection(ChildDOMNode.nodeValue);
  1150.       NODE_PROCESSING_INSTRUCTION:
  1151.         DecodePrologAttrs(ChildDOMNode.nodeValue);
  1152.       NODE_COMMENT:
  1153.         NewNode := CreateComment(ChildDOMNode.nodeValue);
  1154.       NODE_DOCUMENT_TYPE:
  1155.         TXmlDDocument(ParNode).DocumentTypeDefinition :=
  1156.             ChildDOMNode.xml;
  1157.       else
  1158.         if not DiscardUnsupportedItems then
  1159.           raise EXmlDError.Create('XML document contains unsupported ' +
  1160.               'node type of ' + ChildDOMNode.nodeTypeString);
  1161.     end;
  1162.     if (NewNode <> nil) and (ParNode <> nil) then
  1163.       ParNode.AppendChild(NewNode);
  1164.     LoadChildNodes(NewNode, ChildDOMNode);
  1165.     ChildDOMNode := ChildDOMNode.NextSibling;
  1166.   end;
  1167. end;
  1168.  
  1169. procedure TXmlDDocument.LoadFromDOMDocument(Doc: IXMLDOMDocument);
  1170. var
  1171.   Err:  IXMLDOMParseError;
  1172. begin
  1173.   Clear;
  1174.   Err := Doc.parseError;
  1175.   if Err.errorCode <> 0 then
  1176.     raise EXmlDParseError.Create(Err);
  1177.   NodeName := Doc.nodeName;
  1178.   LoadChildNodes(Self, Doc);
  1179. end;
  1180.  
  1181. procedure TXmlDDocument.LoadFromFile(const FileName: String;
  1182.   ValidateOnParse, DiscardUnsupportedItems: Boolean);
  1183. var
  1184.   Doc:  IXMLDOMDocument;
  1185. begin
  1186.   Doc := CoDOMDocument.Create;
  1187.   Doc.validateOnParse := ValidateOnParse;
  1188.   Self.DiscardUnsupportedItems := DiscardUnsupportedItems;
  1189.   Doc.async := False;
  1190.   Doc.load(FileName);
  1191.   LoadFromDOMDocument(Doc);
  1192. end;
  1193.  
  1194. procedure TXmlDDocument.LoadFromStream(Stream: TStream; ValidateOnParse,
  1195.   DiscardUnsupportedItems: Boolean);
  1196. var
  1197.   Doc:  IXMLDOMDocument;
  1198.   SS: TStringStream;
  1199. begin
  1200.   Doc := CoDOMDocument.Create;
  1201.   Doc.validateOnParse := ValidateOnParse;
  1202.   Self.DiscardUnsupportedItems := DiscardUnsupportedItems;
  1203.   if Stream is TStringStream then
  1204.     SS := TStringStream(Stream)
  1205.   else
  1206.   begin
  1207.     SS := TStringStream.Create('');
  1208.     SS.CopyFrom(Stream, Stream.Size);
  1209.   end;
  1210.   SS.Position := 0;
  1211.   Doc.loadXML(PChar(SS.DataString));
  1212.   LoadFromDOMDocument(Doc);
  1213.   if SS <> Stream then
  1214.     SS.Free
  1215.   else
  1216.     SS.Position := 0;
  1217. end;
  1218.  
  1219. function TXmlDDocument.RemoveChild(ThisNode: TXmlDNode): TXmlDNode;
  1220. begin
  1221.   if ThisNode = FDocumentElement then
  1222.     FDocumentElement := nil;
  1223.   Result := inherited RemoveChild(ThisNode);
  1224. end;
  1225.  
  1226. function TXmlDDocument.ReplaceChild(NewNode,
  1227.   OldNode: TXmlDNode): TXmlDNode;
  1228. begin
  1229.   if OldNode = FDocumentElement then
  1230.     FDocumentElement := nil;
  1231.   if NewNode.NodeType = xntElement then
  1232.     FDocumentElement := TXmlDElement(NewNode);
  1233.   Result := inherited ReplaceChild(NewNode, OldNode);
  1234. end;
  1235.  
  1236. procedure TXmlDDocument.SaveToFile(const FileName: String;
  1237.     FormattedForPrint: Boolean);
  1238. var
  1239.   Stream: TStream;
  1240. begin
  1241.   Stream := TFileStream.Create(FileName, fmCreate);
  1242.   try
  1243.     SaveToStream(Stream);
  1244.   finally
  1245.     Stream.Free;
  1246.   end;
  1247. end;
  1248.  
  1249. procedure TXmlDDocument.SaveToStream(Stream: TStream;
  1250.     FormattedForPrint: Boolean = False);
  1251. begin
  1252.   WriteToStream(Stream, FormattedForPrint);
  1253. end;
  1254.  
  1255. procedure TXmlDDocument.WritePrologToStream(Stream: TStream);
  1256. var
  1257.   S:  String;
  1258.   AttrVal:  String;
  1259. begin
  1260.   S := '<?xml version=';
  1261.   AttrVal := FAttrList['version'];
  1262.   if AttrVal <> '' then
  1263.     AppendStr(S, '"' + AttrVal + '"')
  1264.   else
  1265.     AppendStr(S, '"1.0"');
  1266.   AttrVal := FAttrList['encoding'];
  1267.   if AttrVal <> '' then
  1268.     AppendStr(S, ' encoding=' + '"' + AttrVal + '"');
  1269.   AttrVal := FAttrList['standalone'];
  1270.   if AttrVal <> '' then
  1271.     AppendStr(S, ' standalone=' + '"' + AttrVal + '"');
  1272.   AppendStr(S, '?>');
  1273.   Stream.WriteBuffer(Pointer(S)^, Length(S));
  1274. end;
  1275.  
  1276. procedure TXmlDDocument.WriteToStream(Stream: TStream;
  1277.     FormattedForPrint: Boolean);
  1278. begin
  1279.   WritePrologToStream(Stream);
  1280.   if FormattedForPrint then
  1281.     WriteFormattedSuffix(Stream);
  1282.   if FDocumentTypeDefinition <> '' then
  1283.   begin
  1284.     Stream.WriteBuffer(Pointer(FDocumentTypeDefinition)^,
  1285.         Length(FDocumentTypeDefinition));
  1286.     if FormattedForPrint then
  1287.       WriteFormattedSuffix(Stream);
  1288.   end;
  1289.   WriteChildrenToStream(Stream, FormattedForPrint);
  1290. end;
  1291.  
  1292. { TXmlDElement }
  1293.  
  1294. function TXmlDElement.CloneNode(RecurseChildren: Boolean): TXmlDNode;
  1295. var
  1296.   Clone:  TXmlDElement;
  1297. begin
  1298.   Clone := TXmlDElement.Create;
  1299.   Clone.FNodeName := FNodeName;
  1300.   Clone.FAttrList.Assign(FAttrList);
  1301.   if RecurseChildren then
  1302.     Clone.CloneChildren(Self);
  1303.   Result := Clone;
  1304. end;
  1305.  
  1306. constructor TXmlDElement.Create;
  1307. begin
  1308.   inherited Create;
  1309.   FNodeType := xntElement;
  1310. end;
  1311.  
  1312. function TXmlDElement.GetAsBoolean: Boolean;
  1313. begin
  1314.   Result := GetFirstTextNodeValue = '1';
  1315. end;
  1316.  
  1317. function TXmlDElement.GetAsCurrency: Currency;
  1318. begin
  1319.   Result := StrToCurr(GetFirstTextNodeValue);
  1320. end;
  1321.  
  1322. function TXmlDElement.GetAsDate: TDateTime;
  1323. begin
  1324.   Result := ISOStrToDate(GetFirstTextNodeValue);
  1325. end;
  1326.  
  1327. function TXmlDElement.GetAsDateTime: TDateTime;
  1328. begin
  1329.   Result := ISOStrToDateTime(GetFirstTextNodeValue);
  1330. end;
  1331.  
  1332. function TXmlDElement.GetAsInteger: Integer;
  1333. begin
  1334.   Result := StrToInt(GetFirstTextNodeValue);
  1335. end;
  1336.  
  1337. function TXmlDElement.GetAsString: String;
  1338. begin
  1339.   Result := GetFirstTextNodeValue;
  1340. end;
  1341.  
  1342. function TXmlDElement.GetAsTime: TDateTime;
  1343. begin
  1344.   Result := ISOStrToTime(GetFirstTextNodeValue);
  1345. end;
  1346.  
  1347. function TXmlDElement.GetFirstTextNodeValue: String;
  1348. var
  1349.   TextNode: TXmlDNode;
  1350. begin
  1351.   TextNode := FirstChild;
  1352.   if (TextNode = nil) or (TextNode.NodeType <> xntText) then
  1353.     raise EXmlDError.Create('Invalid GetAsXxx call');
  1354.   Result := TextNode.NodeValue;
  1355. end;
  1356.  
  1357. function TXmlDElement.GetNextSiblingElement: TXmlDElement;
  1358. var
  1359.   NextNode: TXmlDNode;
  1360. begin
  1361.   Result := nil;
  1362.   NextNode := NextSibling;
  1363.   while ((NextNode <> nil) and (Result = nil)) do
  1364.   begin
  1365.     if NextNode.NodeType = xntElement then
  1366.       Result := TXmlDELement(NextNode);
  1367.     NextNode := NextNode.NextSibling;
  1368.   end;
  1369. end;
  1370.  
  1371. function TXmlDElement.GetNodeName: TXmlName;
  1372. begin
  1373.   Result := FNodeName;
  1374. end;
  1375.  
  1376. procedure TXmlDElement.SetAsBoolean(const Value: Boolean);
  1377. const
  1378.   BoolStrVal: array[False..True] of String = ('0', '1');
  1379. begin
  1380.   SetFirstTextNodeValue(BoolStrVal[Value]);
  1381. end;
  1382.  
  1383. procedure TXmlDElement.SetAsCurrency(const Value: Currency);
  1384. begin
  1385.   SetFirstTextNodeValue(CurrToStr(Value));
  1386. end;
  1387.  
  1388. procedure TXmlDElement.SetAsDate(const Value: TDateTime);
  1389. begin
  1390.   SetFirstTextNodeValue(ISODateToStr(Value));
  1391. end;
  1392.  
  1393. procedure TXmlDElement.SetAsDateTime(const Value: TDateTime);
  1394. begin
  1395.   SetFirstTextNodeValue(ISODateTimeToStr(Value));
  1396. end;
  1397.  
  1398. procedure TXmlDElement.SetAsInteger(const Value: Integer);
  1399. begin
  1400.   SetFirstTextNodeValue(IntToStr(Value));
  1401. end;
  1402.  
  1403. procedure TXmlDElement.SetAsString(const Value: String);
  1404. begin
  1405.   SetFirstTextNodeValue(Value);
  1406. end;
  1407.  
  1408. procedure TXmlDElement.SetAsTime(const Value: TDateTime);
  1409. begin
  1410.   SetFirstTextNodeValue(ISOTimeToStr(Value));
  1411. end;
  1412.  
  1413. procedure TXmlDElement.SetFirstTextNodeValue(const Value: String);
  1414. var
  1415.   TextNode: TXmlDNode;
  1416. begin
  1417.   TextNode := FirstChild;
  1418.   if TextNode = nil then
  1419.   begin
  1420.     TextNode := TXmlDText.Create;
  1421.     TextNode.NodeValue := Value;
  1422.     AppendChild(TextNode);
  1423.   end
  1424.   else
  1425.   begin
  1426.     if TextNode.NodeType <> xntText then
  1427.       raise EXmlDError.Create('Invalid SetAsXxx call');
  1428.     TextNode.NodeValue := Value;
  1429.   end;
  1430. end;
  1431.  
  1432. procedure TXmlDElement.SetNodeName(const Value: TXmlName);
  1433. begin
  1434.   FNodeName := Value;
  1435. end;
  1436.  
  1437. procedure TXmlDElement.WriteToStream(Stream: TStream;
  1438.     FormattedForPrint: Boolean);
  1439. var
  1440.   S:  String;
  1441.   Formatted: Boolean;
  1442. begin
  1443.   Formatted := FormattedForPrint;
  1444.   if Formatted then
  1445.   begin
  1446.     if (FFirstChild <> nil) and (FFirstChild = FLastChild) and
  1447.         (FFirstChild.NodeType = xntText) and
  1448.         (Length(FFirstChild.NodeValue) < 48) then
  1449.       Formatted := False;
  1450.     WriteFormattedPrefix(Stream);
  1451.   end;
  1452.   S := '<' + FNodeName;
  1453.   Stream.WriteBuffer(Pointer(S)^, Length(S));
  1454.   if FAttrList.Count > 0 then
  1455.     FAttrList.WriteToStream(Stream);
  1456.   if FFirstChild <> nil then
  1457.   begin
  1458.     S := '>';
  1459.     Stream.WriteBuffer(Pointer(S)^, 1);
  1460.     if Formatted then
  1461.       WriteFormattedSuffix(Stream);
  1462.   end;
  1463.   if FFirstChild = nil then
  1464.     S := '/>'
  1465.   else
  1466.   begin
  1467.     WriteChildrenToStream(Stream, Formatted);
  1468.     if Formatted then
  1469.       WriteFormattedPrefix(Stream);
  1470.     S := '</' + FNodeName + '>';
  1471.   end;
  1472.   Stream.WriteBuffer(Pointer(S)^, Length(S));
  1473.   if FormattedForPrint then
  1474.     WriteFormattedSuffix(Stream);
  1475. end;
  1476.  
  1477. { TXmlDDocumentFragment }
  1478.  
  1479. function TXmlDDocumentFragment.CloneNode(
  1480.   RecurseChildren: Boolean): TXmlDNode;
  1481. var
  1482.   Clone:  TXmlDDocumentFragment;
  1483. begin
  1484.   Clone := TXmlDDocumentFragment.Create;
  1485.   if RecurseChildren then
  1486.     Clone.CloneChildren(Self);
  1487.   Result := Clone;
  1488. end;
  1489.  
  1490. constructor TXmlDDocumentFragment.Create;
  1491. begin
  1492.   inherited Create;
  1493.   FNodeType := xntDocumentFragment;
  1494. end;
  1495.  
  1496. procedure TXmlDDocumentFragment.WriteToStream(Stream: TStream;
  1497.   FormattedForPrint: Boolean);
  1498. begin
  1499. end;
  1500.  
  1501. { TXmlDText }
  1502.  
  1503. function TXmlDText.CloneNode(RecurseChildren: Boolean): TXmlDNode;
  1504. begin
  1505.   Result := TXmlDText.Create;
  1506.   Result.NodeValue := NodeValue;
  1507. end;
  1508.  
  1509. constructor TXmlDText.Create;
  1510. begin
  1511.   inherited Create;
  1512.   FNodeType := xntText;
  1513. end;
  1514.  
  1515. procedure TXmlDText.WriteToStream(Stream: TStream;
  1516.     FormattedForPrint: Boolean);
  1517. var
  1518.   S:  String;
  1519.   Skip: Boolean;
  1520.   D:  TXmlDDocument;
  1521. begin
  1522.   if FormattedForPrint then
  1523.     WriteFormattedPrefix(Stream);
  1524.   S := FValue;
  1525.   Skip := False;
  1526.   D := OwnerDocument;
  1527.   if Assigned(D.FOnOutputTextValue) then
  1528.     D.FOnOutputTextValue(Self, S, Skip);
  1529.   if (not Skip) and (D.FTextCharEntities <> []) then
  1530.     S := CharEntitiesReplace(S, D.FTextCharEntities);
  1531.   Stream.WriteBuffer(Pointer(S)^, Length(S));
  1532.   if FormattedForPrint then
  1533.     WriteFormattedSuffix(Stream);
  1534. end;
  1535.  
  1536. { TXmlDComment }
  1537.  
  1538. function TXmlDComment.CloneNode(RecurseChildren: Boolean): TXmlDNode;
  1539. begin
  1540.   Result := TXmlDComment.Create;
  1541.   Result.NodeValue := NodeValue;
  1542. end;
  1543.  
  1544. constructor TXmlDComment.Create;
  1545. begin
  1546.   inherited Create;
  1547.   FNodeType := xntComment;
  1548. end;
  1549.  
  1550. procedure TXmlDComment.WriteToStream(Stream: TStream;
  1551.   FormattedForPrint: Boolean);
  1552. var
  1553.   S:  String;
  1554. begin
  1555.   if FormattedForPrint then
  1556.     WriteFormattedPrefix(Stream);
  1557.   S := '<!--' + FValue + '-->';
  1558.   Stream.WriteBuffer(Pointer(S)^, Length(S));
  1559.   if FormattedForPrint then
  1560.     WriteFormattedSuffix(Stream);
  1561. end;
  1562.  
  1563. { TXmlCDATASection }
  1564.  
  1565. function TXmlDCDATASection.CloneNode(RecurseChildren: Boolean): TXmlDNode;
  1566. begin
  1567.   Result := TXmlDCDATASection.Create;
  1568.   Result.NodeValue := NodeValue;
  1569. end;
  1570.  
  1571. constructor TXmlDCDATASection.Create;
  1572. begin
  1573.   inherited Create;
  1574.   FNodeType := xntCDATASection;
  1575. end;
  1576.  
  1577. procedure TXmlDCDATASection.WriteToStream(Stream: TStream;
  1578.     FormattedForPrint: Boolean);
  1579. var
  1580.   S:  String;
  1581. begin
  1582.   if FormattedForPrint then
  1583.     WriteFormattedPrefix(Stream);
  1584.   S := '<![CDATA[' + FValue + ']]>';
  1585.   Stream.WriteBuffer(Pointer(S)^, Length(S));
  1586.   if FormattedForPrint then
  1587.     WriteFormattedSuffix(Stream);
  1588. end;
  1589.  
  1590. { TXmlDAttrList }
  1591.  
  1592. function TXmlDAttrList.Add(const S: String): Integer;
  1593. begin
  1594.   Result := List.Add(S);
  1595. end;
  1596.  
  1597. procedure TXmlDAttrList.Assign(Source: TPersistent);
  1598. begin
  1599.   if Source is TXmlDAttrList then
  1600.     List.Assign(TXmlDAttrList(Source).List);
  1601. end;
  1602.  
  1603. procedure TXmlDAttrList.Clear;
  1604. begin
  1605.   List.Clear;
  1606. end;
  1607.  
  1608. constructor TXmlDAttrList.Create;
  1609. begin
  1610.   inherited Create;
  1611.   List := TStringList.Create;
  1612. end;
  1613.  
  1614. destructor TXmlDAttrList.Destroy;
  1615. begin
  1616.   List.Free;
  1617.   inherited Destroy;
  1618. end;
  1619.  
  1620. function TXmlDAttrList.GetCount: Integer;
  1621. begin
  1622.   Result := List.Count;
  1623. end;
  1624.  
  1625. function TXmlDAttrList.GetNames(Index: Integer): TXmlName;
  1626. begin
  1627.   Result := List.Names[Index];
  1628. end;
  1629.  
  1630. function TXmlDAttrList.GetValues(const Name: TXmlName): String;
  1631. begin
  1632.   Result := List.Values[Name];
  1633. end;
  1634.  
  1635. procedure TXmlDAttrList.SetValues(const Name: TXmlName;
  1636.   const Value: String);
  1637. begin
  1638.   List.Values[Name] := Value;
  1639. end;
  1640.  
  1641. procedure TXmlDAttrList.WriteToStream(Stream: TStream);
  1642. var
  1643.   I:  Integer;
  1644.   J:  Integer;
  1645.   S:  String;
  1646.   Val: String;
  1647.   Skip: Boolean;
  1648.   D:  TXmlDDocument;
  1649. begin
  1650.   D := FOwnerNode.OwnerDocument;
  1651.   for I := 0 to (List.Count - 1) do
  1652.   begin
  1653.     S := List[I];
  1654.     J := Pos('=', S);
  1655.     Val := Copy(S, J + 1, $7FFF);
  1656.     Skip := False;
  1657.     if Assigned(D.FOnOutputAttrValue) then
  1658.       D.FOnOutputAttrValue(Self, Val, Skip);
  1659.     if (not Skip) and (D.FAttrCharEntities <> []) then
  1660.       Val := CharEntitiesReplace(Val, D.FAttrCharEntities);
  1661.     S := ' ' + Copy(S, 1, J) + '"' + Val + '"';
  1662.     Stream.WriteBuffer(Pointer(S)^, Length(S));
  1663.   end;
  1664. end;
  1665.  
  1666. { TXmlElementIterator }
  1667.  
  1668. constructor TXmlDElementIterator.Create(ContextNode: TXmlDStructureNode;
  1669.   const Pattern: String);
  1670. begin
  1671.   inherited Create;
  1672.   Position := TList.Create;
  1673.   RootNode := ContextNode;
  1674.   CurrNode := ContextNode;
  1675.   if Pattern <> '' then
  1676.     ElementPattern := TXmlDElementPattern.Create(RootNode, Pattern);
  1677. end;
  1678.  
  1679. destructor TXmlDElementIterator.Destroy;
  1680. begin
  1681.   ElementPattern.Free;
  1682.   Position.Free;
  1683.   inherited Destroy;
  1684. end;
  1685.  
  1686. function TXmlDElementIterator.Next: TXmlDElement;
  1687. begin
  1688.   Result := nil;
  1689.   if CurrNode = nil then
  1690.     Exit;
  1691.   if ElementPattern = nil then
  1692.     Result := NextElementInStructure
  1693.   else
  1694.     Result := NextElementInPattern;
  1695. end;
  1696.  
  1697. function TXmlDElementIterator.NextElementInPattern: TXmlDElement;
  1698.  
  1699.   function GetFirstElementInPattern(StartNode: TXmlDStructureNode):
  1700.       TXmlDElement;
  1701.   var
  1702.     CandidateElement: TXmlDElement;
  1703.   begin
  1704.     Result := nil;
  1705.     if StartNode.ElementCount > 0 then
  1706.     begin
  1707.       CandidateElement := StartNode.GetFirstChildElement;
  1708.       while ((CandidateElement <> nil) and (Result = nil)) do
  1709.       begin
  1710.         case ElementPattern.PatternMatchType(CandidateElement) of
  1711.           epmEndMatch:
  1712.             Result := CandidateElement;
  1713.           epmPathMatch:
  1714.             Result := GetFirstElementInPattern(CandidateElement);
  1715.         end;
  1716.         if Result = nil then
  1717.           CandidateElement := CandidateElement.GetNextSiblingElement;
  1718.       end;
  1719.     end;
  1720.   end;
  1721.  
  1722.   function GetNextElementInPattern:TXmlDElement;
  1723.   var
  1724.     CandidateElement: TXmlDElement;
  1725.  
  1726.     function GetNextCandidate(StartNode: TXmlDStructureNode): TXmlDElement;
  1727.     begin
  1728.       Result := TXmlDElement(StartNode).GetNextSiblingElement;
  1729.       if Result = nil then
  1730.       begin
  1731.         if StartNode.ParentNode <> RootNode then
  1732.         begin
  1733.           Result := TXmlDElement(StartNode.ParentNode).
  1734.               GetNextSiblingElement;
  1735.           if Result = nil then
  1736.             Result := GetNextCandidate(StartNode.ParentNode);
  1737.         end;
  1738.       end;
  1739.     end;
  1740.  
  1741.   begin
  1742.     Result := GetFirstElementInPattern(CurrNode);
  1743.     if Result <> nil then
  1744.       Exit;
  1745.     CandidateElement := GetNextCandidate(CurrNode);
  1746.     while ((CandidateElement <> nil) and (Result = nil)) do
  1747.     begin
  1748.       if CandidateElement <> nil then
  1749.       begin
  1750.         case ElementPattern.PatternMatchType(CandidateElement) of
  1751.           epmEndMatch:
  1752.             Result := CandidateElement;
  1753.           epmPathMatch:
  1754.             Result := GetFirstElementInPattern(CandidateElement);
  1755.         end;
  1756.         if Result = nil then
  1757.           CandidateElement := GetNextCandidate(CandidateElement);
  1758.       end;
  1759.     end;
  1760.   end;
  1761.  
  1762. begin
  1763.   if CurrNode = RootNode then
  1764.     Result := GetFirstElementInPattern(RootNode)
  1765.   else
  1766.     Result := GetNextElementInPattern;
  1767.   CurrNode := Result;
  1768. end;
  1769.  
  1770. function TXmlDElementIterator.NextElementInStructure: TXmlDElement;
  1771. begin
  1772.   if CurrNode = RootNode then
  1773.     Result := RootNode.GetFirstChildElement
  1774.   else
  1775.   begin
  1776.     if CurrNode.ElementCount > 0 then
  1777.     begin
  1778.       Result := CurrNode.GetFirstChildElement;
  1779.     end
  1780.     else
  1781.     begin
  1782.       Result := TXmlDElement(CurrNode).GetNextSiblingElement;
  1783.       if Result = nil then
  1784.       begin
  1785.         while (Result = nil) do
  1786.         begin
  1787.           CurrNode := CurrNode.ParentNode;
  1788.           if CurrNode = RootNode then
  1789.             Break;
  1790.           Result := TXmlDElement(CurrNode).GetNextSiblingElement;
  1791.         end;
  1792.       end;
  1793.     end;
  1794.   end;
  1795.   CurrNode := Result;
  1796. end;
  1797.  
  1798. procedure TXmlDElementIterator.Reset(ContextNode: TXmlDStructureNode;
  1799.   const Pattern: String);
  1800. begin
  1801.   RootNode := ContextNode;
  1802.   CurrNode := ContextNode;
  1803.   ElementPattern.Free;
  1804.   ElementPattern := nil;
  1805.   if Pattern <> '' then
  1806.     ElementPattern := TXmlDElementPattern.Create(RootNode, Pattern);
  1807. end;
  1808.  
  1809. { TXmlDElementPattern }
  1810.  
  1811. constructor TXmlDElementPattern.Create(Contextnode: TXmlDStructureNode;
  1812.     const Pattern: String);
  1813. begin
  1814.   inherited Create;
  1815.   RootNode := ContextNode;
  1816.   PatternPieces := TStringList.Create;
  1817.   ParsePattern(Pattern);
  1818. end;
  1819.  
  1820. destructor TXmlDElementPattern.Destroy;
  1821. begin
  1822.   PatternPieces.Free;
  1823.   inherited Destroy;
  1824. end;
  1825.  
  1826. procedure TXmlDElementPattern.ParsePattern(const Pattern: String);
  1827. var
  1828.   I: Integer;
  1829.   Lvl: Integer;
  1830.   S: String;
  1831.  
  1832.   procedure ParsePatternLevel(const Pattern: String);
  1833.   var
  1834.     I: Integer;
  1835.     S: String;
  1836.   begin
  1837.     S := Pattern;
  1838.     while (S <> '') do
  1839.     begin
  1840.       I := Pos('|', S);
  1841.       if I > 0 then
  1842.       begin
  1843.         PatternPieces.AddObject(Trim(Copy(S, 1, (I - 1))),
  1844.             Pointer(Lvl));
  1845.         S := Copy(S, (I + 1), $7FFF);
  1846.       end
  1847.       else
  1848.       begin
  1849.         PatternPieces.AddObject(Trim(S), Pointer(Lvl));
  1850.         S := '';
  1851.       end;
  1852.     end;
  1853.   end;
  1854.  
  1855. begin
  1856.   PatternPieces.Clear;
  1857.   S := Pattern;
  1858.   Lvl := 0;
  1859.   while (S <> '') do
  1860.   begin
  1861.     Inc(Lvl);
  1862.     PatternLevels := Lvl;
  1863.     I := Pos('/', S);
  1864.     if I = 0 then
  1865.     begin
  1866.       ParsePatternLevel(S);
  1867.       S := '';
  1868.     end
  1869.     else
  1870.     begin
  1871.       ParsePatternLevel(Copy(S, 1, (I - 1)));
  1872.       S := Copy(S, (I + 1), $7FFF);
  1873.     end;
  1874.   end;
  1875. end;
  1876.  
  1877. function TXmlDElementPattern.PatternMatchType(Element: TXmlDElement):
  1878.     TElementPatternMatch;
  1879. var
  1880.   I: Integer;
  1881.   Lvl: Integer;
  1882. begin
  1883.   Result := epmNoMatch;
  1884.   Lvl := Element.Level - RootNode.Level;
  1885.   if Lvl > PatternLevels then
  1886.     Exit;
  1887.   for I := 0 to (PatternPieces.Count - 1) do
  1888.   begin
  1889.     if (Integer(PatternPieces.Objects[I]) = Lvl) and
  1890.         ((PatternPieces[I] = '*') or
  1891.             (PatternPieces[I] = Element.NodeName)) then
  1892.     begin
  1893.       Result := epmPathMatch;
  1894.       Break;
  1895.     end;
  1896.   end;
  1897.   if (Result = epmPathMatch) and (Lvl = PatternLevels) then
  1898.     Result := epmEndMatch;
  1899. end;
  1900.  
  1901. end.
  1902.